home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / HSCDINLE.BAS < prev    next >
BASIC Source File  |  1980-01-10  |  18KB  |  513 lines
  1. DECLARE SUB EkranYaz (Dosya$(), Diz$(), V1!)
  2. DECLARE FUNCTION AdlibAra! ()
  3. DECLARE SUB AnaMenu ()
  4. DECLARE SUB Arkaplanciz ()
  5. DECLARE SUB Bekle ()
  6. DECLARE SUB Bekle1 ()
  7. DECLARE SUB Bul (BulDosya$, Dosya$(), Diz$())
  8. DECLARE SUB CerceveCiz (MenuYatay!, MenuDikey!, MenuYuksek!, MenuGenis!, MenuAd$)
  9. DECLARE FUNCTION Dizin$ (Ara$)
  10. DECLARE SUB Express (A$)
  11. DECLARE SUB SecimDiz (Dosya$(), Diz$(), T$)
  12. DECLARE SUB SecimDos (Dosya$(), Diz$())
  13. DECLARE SUB Tarama ()
  14. DECLARE SUB Yardim ()
  15. DECLARE SUB Dinle (BYVAL Segm%, BYVAL Ofset%, BYVAL Bel%)
  16. DECLARE SUB Kapa ()
  17. DECLARE SUB YavasKapa ()
  18. DECLARE SUB FontText ()
  19. DECLARE SUB Ekransakla ()
  20. DECLARE SUB EkranKoy ()
  21. DECLARE SUB Bellek (A%)
  22. TYPE Dosyalar
  23.       Ax    AS INTEGER
  24.       Bx    AS INTEGER
  25.       Cx    AS INTEGER
  26.       Dx    AS INTEGER
  27.       bp    AS INTEGER
  28.       si    AS INTEGER
  29.       di    AS INTEGER
  30.       Flags AS INTEGER
  31.       Ds    AS INTEGER
  32.       Es    AS INTEGER
  33.       Dosya AS STRING * 64            'Dosya ismi bu deºiƒkende olacak
  34.       HscDt AS STRING * 15000
  35. END TYPE
  36. DECLARE SUB Interruptx (Kesme AS INTEGER, Git AS Dosyalar, Gel AS Dosyalar)
  37. DIM SHARED Yap AS Dosyalar
  38. DIM SHARED Dosya$(301), Diz$(301), Mes$
  39. DIM SHARED Sur$, Dz$, DosyaUzan$, EskiSur$, EskiDiz$, Adet1, Adet2
  40. DIM SHARED BellekC%
  41. ON ERROR GOTO Hatalar
  42. A$ = COMMAND$: IF A$ <> "" THEN Express (A$)
  43. DosyaUzan$ = ".HSC"
  44. Arkaplanciz
  45. EskiSur$ = LEFT$(CURDIR$, 2): EskiDiz$ = RIGHT$(CURDIR$, LEN(CURDIR$) - 2)
  46. AnaMenu
  47. Hatalar:
  48.      CALL CerceveCiz(12, 9, 2, 40, "")
  49.      LOCATE 13, 10
  50.      IF ERR = 71 THEN
  51.       PRINT "Disket yerleƒtir.<T-Tekrar>, <Esc-ÿptal>"
  52.       DO
  53.         DO: A$ = INKEY$: LOOP UNTIL A$ <> ""
  54.         SELECT CASE A$
  55.         CASE CHR$(27)
  56.         CHDRIVE EskiSur$: CHDIR EskiDiz$: RESUME
  57.         CASE "t", "T", CHR$(13)
  58.         RESUME
  59.         END SELECT
  60.         BEEP
  61.       LOOP
  62.      END IF
  63.  
  64. FUNCTION AdlibAra
  65.    OUT &H388, 4: Bekle1: OUT &H389, &H60: Bekle1
  66.    OUT &H388, 4: Bekle1: OUT &H389, &H80: Bekle1
  67.    A = INP(&H388)
  68.    OUT &H388, 2: Bekle1: OUT &H389, &HFF: Bekle1
  69.    OUT &H388, 4: Bekle1: OUT &H389, &H21: Bekle1
  70.    Bekle
  71.    B = INP(&H388)
  72.    OUT &H388, 4: Bekle1: OUT &H389, &H60: Bekle1
  73.    OUT &H388, 4: Bekle1: OUT &H389, &H80: Bekle1
  74.    IF (A AND &HE0) = 0 AND (B AND &HE0) = &HC0 THEN AdlibAra = 1
  75. END FUNCTION
  76.  
  77. SUB AnaMenu
  78.      PCOPY 3, 0
  79.      Ara = AdlibAra
  80.      IF Ara <> 1 THEN
  81.     CALL CerceveCiz(12, 9, 2, 40, "")
  82.     LOCATE 13, 10: PRINT "Hata: Adlib uyumlu ses kartì bulunamadì!"
  83.     DO: LOOP UNTIL INKEY$ <> ""
  84.      ELSE
  85.     Tarama
  86.     CALL Bellek(11913): BellekC% = Yap.Ax
  87.     CALL SecimDos(Dosya$(), Diz$())
  88.      END IF
  89.      CHDRIVE EskiSur$: CHDIR EskiDiz$
  90.      SCREEN 2: SCREEN 0: COLOR 7, 1: CLS : END
  91. END SUB
  92.  
  93. SUB Arkaplanciz
  94.   SCREEN 2: SCREEN 0: FontText
  95.   EkranAdresi = &HB800
  96.   SCREEN , , 3, 0
  97.   COLOR 9, 7: CLS
  98.     A$ = "Bir Gürol DEMÿR & M.Doºan ÖZDEMÿR yapìmì, PS - (G&D), 1996..."
  99.     A = LEN(A$)
  100.     FOR I = 0 TO 1840 / A
  101.        B = 80 - C
  102.        IF B <= A THEN
  103.       PRINT LEFT$(A$, B);
  104.       PRINT RIGHT$(A$, A - B);
  105.       C = A - B: D = C
  106.        ELSE
  107.       PRINT A$;
  108.       C = C + A
  109.        END IF
  110.     NEXT
  111.   DEF SEG = EkranAdresi + 256 * 3
  112.     FOR I = 3680 + D * 2 TO 4000 STEP A * 2
  113.        FOR Y = 1 TO A
  114.     POKE I + (Y - 1) * 2, ASC(MID$(A$, Y, 1))
  115.        NEXT
  116.     NEXT
  117.      CALL CerceveCiz(3, 4, 19, 70, " Dinlenecek müzik parçasì (.hsc) ")
  118.      CALL CerceveCiz(4, 7, 2, 14, "")
  119.      CALL CerceveCiz(4, 24, 2, 48, "")
  120.      CALL CerceveCiz(7, 7, 14, 44, "Dosyalar")
  121.      CALL CerceveCiz(7, 57, 14, 14, "Diz./Sürücü")
  122.      LOCATE 13, 54: PRINT "Y"
  123.      LOCATE 14, 54: PRINT "a"
  124.      LOCATE 15, 54: PRINT "r"
  125.      LOCATE 16, 54: PRINT "d"
  126.      LOCATE 17, 54: PRINT "ì"
  127.      LOCATE 18, 54: PRINT "m"
  128.      LOCATE 12, 53: PRINT "■F1■"
  129.      LOCATE 19, 53: PRINT "■F1■"
  130.      COLOR 1, 3
  131.       LOCATE 21, 8: PRINT CHR$(27); STRING$(42, "░"); CHR$(26);
  132.       FOR I = 8 TO 19
  133.     LOCATE I, 72: PRINT "░"
  134.       NEXT
  135.        LOCATE 8, 72: PRINT CHR$(24)
  136.        LOCATE 20, 72: PRINT CHR$(25)
  137.     SCREEN , , 0
  138.        KEY 1, CHR$(254): KEY 2, CHR$(253): KEY 10, CHR$(255)
  139. END SUB
  140.  
  141. SUB Bekle
  142.      DEF SEG = 0
  143.      FOR I = 1 TO 5
  144.       A = PEEK(1132): DO
  145.         IF PEEK(1052) <> PEEK(1050) THEN EXIT SUB
  146.       LOOP UNTIL PEEK(1132) <> A
  147.      NEXT
  148. END SUB
  149.  
  150. SUB Bekle1
  151.      DEF SEG = 0: A = PEEK(1132): DO: LOOP UNTIL PEEK(1132) <> A
  152. END SUB
  153.  
  154. SUB Bellek (A%)
  155.     Bos& = SETMEM(-1 * (A% + 17))
  156.     Yap.Ax = &H4800: Yap.Bx = A% \ 16 + 1
  157.     CALL Interruptx(&H21, Yap, Yap)
  158.     IF (Yap.Flags AND 1) THEN PRINT "Hata": END
  159. END SUB
  160.  
  161. SUB Bul (BulDosya$, Dosya$(), Diz$())
  162.      Bulundu$ = Dizin$(BulDosya$)
  163.      DO WHILE LEN(Bulundu$)
  164.     DosyaAdsonu = INSTR(31, Bulundu$, CHR$(0))
  165.     A$ = LEFT$(MID$(Bulundu$, 31, DosyaAdsonu - 31) + SPACE$(12), 12)
  166.     IF (ASC(MID$(Bulundu$, 22, 4)) AND &H10) THEN
  167.          IF LEFT$(A$, 2) <> ". " AND Diz < 300 THEN Diz$(Diz) = A$: Diz = Diz + 1
  168.     ELSE
  169.          IF CVL(MID$(Bulundu$, 27, 4)) > 0 AND Dos < 300 AND INSTR(A$, DosyaUzan$) > 0 THEN Dosya$(Dos) = A$: Dos = Dos + 1
  170.     END IF
  171.     Bulundu$ = Dizin$("")
  172.      LOOP
  173.     Adet1 = Dos: Adet2 = Diz
  174.     FOR I = 1 TO Dos - 1: FOR Y = 0 TO Dos
  175.        IF Dosya$(I) < Dosya$(Y) THEN SWAP Dosya$(I), Dosya$(Y)
  176.     NEXT: NEXT
  177.     FOR I = 1 TO Diz - 1: FOR Y = 0 TO Diz
  178.        IF Diz$(I) < Diz$(Y) THEN SWAP Diz$(I), Diz$(Y)
  179.     NEXT: NEXT
  180.     Diz$(Diz) = "[-A-]": Diz = Diz + 1
  181.     DEF SEG = 0: A = PEEK(&H475)
  182.     IF A > 0 THEN Diz$(Diz) = "[-C-]": Diz = Diz + 1: Diz$(Diz) = "[-D-]": Diz = Diz + 1
  183. END SUB
  184.  
  185. SUB CerceveCiz (MenuYatay, MenuDikey, MenuYuksek, MenuGenis, MenuAd$)
  186.    COLOR 14, 1
  187.    FOR I = 1 TO MenuYuksek - 1
  188.      LOCATE MenuYatay + I, MenuDikey: PRINT "│"; STRING$(MenuGenis, " "); "│"
  189.    NEXT
  190.    LOCATE MenuYatay, MenuDikey
  191.      PRINT "┌"; STRING$(MenuGenis, "─"); "┐"
  192.    LOCATE MenuYatay + MenuYuksek, MenuDikey
  193.      PRINT "└"; STRING$(MenuGenis, "─"); "┘";
  194.  
  195.    LOCATE MenuYatay, MenuDikey + (MenuGenis - LEN(MenuAd$)) \ 2 + 1: PRINT MenuAd$
  196.  
  197. IF MenuYatay <> 3 THEN EXIT SUB
  198.    FOR I = 1 TO MenuGenis + 1
  199.      POKE ((MenuYatay + MenuYuksek) * 160 + (MenuDikey + I) * 2 + 1), 9
  200.    NEXT
  201.    FOR I = 1 TO MenuYuksek + 1
  202.      TR = ((MenuYatay + I - 1) * 160 + (MenuDikey + MenuGenis + 1) * 2 + 1)
  203.      POKE TR, 9: POKE TR + 2, 9
  204.    NEXT
  205. END SUB
  206.  
  207. FUNCTION Dizin$ (Ara$) STATIC
  208.  
  209.       DIM DiskTransferYeri AS STRING * 44, Bak AS Dosyalar
  210.      
  211.       Bak.Ax = &H1A00
  212.       Bak.Dx = VARPTR(DiskTransferYeri)
  213.       Bak.Ds = VARSEG(DiskTransferYeri)
  214.       Interruptx &H21, Bak, Bak
  215.      
  216.     IF LEN(Ara$) THEN
  217.        Ara$ = Ara$ + CHR$(0)
  218.        Bak.Dosya = Ara$
  219.  
  220.        Bak.Ax = &H4E00
  221.        Bak.Cx = 1 + 2 + 4 + 16 + 32     'Bütün dosya ve dizinlere bak
  222.                         '+1 =  Normal dosyalar dahil
  223.                         '+2 =  Gizli dosyalar dahil
  224.                         '+4 =  Sistem dosyalarì dahil
  225.                         '+8 =  Disk labeli dahil
  226.                         '+16 = Alt Dizinler dahil
  227.                         '+32 = Arsiv dosyalarì dahil
  228.  
  229.        Bak.Dx = VARPTR(Bak.Dosya)
  230.        Bak.Ds = VARSEG(Bak.Dosya)
  231.     ELSE
  232.        Bak.Ax = &H4F00
  233.     END IF
  234.      
  235.     Interruptx &H21, Bak, Bak
  236.  
  237.     IF Bak.Flags AND 1 THEN            'Bulunamadì
  238.        Dizin$ = ""
  239.     ELSE
  240.        Dizin$ = DiskTransferYeri       'Bulundu
  241.     END IF
  242. END FUNCTION
  243.  
  244. SUB EkranYaz (Dosya$(), Diz$(), V1)
  245.     FOR I = 0 TO 12
  246.      COLOR 15, 1
  247.      LOCATE 8 + I, 9: PRINT SPACE$(42);
  248.      LOCATE , 9: PRINT Dosya$(I + V1 * 13); : LOCATE , 24: PRINT Dosya$(I + 13 + V1 * 13); : LOCATE , 39: PRINT Dosya$(I + 26 + V1 * 13); : LOCATE , 59: PRINT Diz$(I);
  249.      COLOR 30, 1
  250.      IF Dosya$(I + V1 * 13) = Mes$ THEN LOCATE , 9: PRINT Mes$
  251.      IF Dosya$(I + 13 + V1 * 13) = Mes$ THEN LOCATE , 24: PRINT Mes$
  252.      IF Dosya$(I + 26 + V1 * 13) = Mes$ THEN LOCATE , 39: PRINT Mes$
  253.     NEXT
  254. END SUB
  255.  
  256. SUB Express (A$)
  257.      ON LOCAL ERROR GOTO HataExpres
  258.      IF INSTR(A$, "?") > 0 OR A$ = "H" OR A$ = "/H" OR A$ = "-H" THEN Yardim: END
  259.      IF INSTR(A$, ".") = 0 THEN A$ = A$ + ".HSC"
  260.      COLOR 7, 1: CLS : Ara = AdlibAra
  261.      IF Ara <> 1 THEN
  262.     PRINT "Hata: Adlib uyumlu ses kartì bulunamadì!"
  263.      ELSE
  264.     CLOSE #1: OPEN A$ FOR BINARY AS #1
  265.     IF LOF(1) = 0 THEN CLOSE #1: KILL A$: END
  266.     CALL Bellek(11913): BellekC% = Yap.Ax
  267.     Yap.HscDt = SPACE$(LOF(1))
  268.     GET #1, , Yap.HscDt
  269.     Dinle VARSEG(Yap.HscDt), VARPTR(Yap.HscDt), BellekC%
  270.     LOCATE , 1: PRINT "Geri dönüƒ için ≈EXIT≈ yazmanìz gerekir.": SHELL
  271.     DO
  272.        COLOR 7, 1: CLS
  273.        LOCATE , 1: PRINT "Esc)Bitir   Enter)Dos'a geri dön"
  274.        DO: A$ = INKEY$: LOOP UNTIL A$ <> ""
  275.          IF A$ = CHR$(27) THEN YavasKapa: FOR I = 1 TO 5: Bekle: NEXT: Kapa: CLS : END
  276.          IF A$ = CHR$(13) THEN CLS : LOCATE , 1: PRINT "Geri dönüƒ için ≈EXIT≈ yazmanìz gerekir.": SHELL
  277.      LOOP
  278.      END IF
  279. HataExpres:
  280.      Yardim
  281.      END
  282. END SUB
  283.  
  284. SUB SecimDiz (Dosya$(), Diz$(), T$)
  285.      Ses = ASC(T$): COLOR 7, 1: LOCATE 5, 9: PRINT SPACE$(12)
  286.      Yer1 = 8
  287.   DO
  288.      SELECT CASE Yer1
  289.        CASE 21
  290.       Yer1 = 20: R1 = R1 + 1
  291.        CASE 7
  292.       Yer1 = 8: R1 = R1 - 1
  293.      END SELECT
  294.      COLOR 15, 1
  295.      FOR I = 0 TO 12
  296.        LOCATE 8 + I, 58: PRINT LEFT$(" " + Diz$(I + R1) + SPACE$(12), 14)
  297.      NEXT
  298.      R = Yer1 - 8 + R1
  299.      Sec1$ = Diz$(R)
  300.      COLOR 1, 15: LOCATE Yer1, 58: PRINT LEFT$(" " + Sec1$ + "        ", 14)
  301.      COLOR 14, 1: LOCATE 9 + R / 27, 72: PRINT "█"
  302.      COLOR 15, 1: LOCATE 5, 26: PRINT RIGHT$(Sur$ + Dz$, 31);
  303.      IF LEFT$(Sec1$, 1) <> "." AND LEFT$(Sec1$, 1) <> "[" THEN PRINT Sec1$
  304.      DO: A$ = INKEY$: LOOP UNTIL A$ <> "": T$ = A$
  305.      LOCATE Yer1, 58: PRINT LEFT$(" " + Sec1$ + "        ", 14)
  306.      COLOR 1, 3: LOCATE 9 + R / 27, 72: PRINT "░"
  307.      SELECT CASE ASC(A$)
  308.         CASE 27
  309.           EXIT SUB
  310.         CASE 9
  311.           EXIT SUB
  312.         CASE 13
  313.           IF LEFT$(Sec1$, 1) = "[" THEN CHDRIVE MID$(Sec1$, 3, 1) + ":" ELSE CHDIR RTRIM$(Sec1$)
  314.           EXIT SUB
  315.        CASE 255
  316.          IF Ses = 1 THEN
  317.          PCOPY 0, 2: Ekransakla
  318.          EskiS$ = LEFT$(CURDIR$, 2): EskiD$ = RIGHT$(CURDIR$, LEN(CURDIR$) - 2)
  319.          COLOR 7, 1: CLS : PRINT "Geri dönüƒ için ≈EXIT≈ yazmanìz gerekir."
  320.          SHELL: CHDRIVE EskiS$: CHDIR EskiD$: EkranKoy: PCOPY 2, 0
  321.          END IF
  322.         CASE 254: Yardim
  323.      END SELECT
  324.      IF LEN(A$) = 2 THEN
  325.     Z = ASC(RIGHT$(A$, 1))
  326.     SELECT CASE Z
  327.          CASE 79, 80, 81
  328.            IF Diz$(R + 1) <> "" THEN Yer1 = Yer1 + 1
  329.          CASE 71, 72, 73
  330.            IF R > 0 THEN IF Diz$(R - 1) <> "" THEN Yer1 = Yer1 - 1
  331.     END SELECT
  332.      END IF
  333.   LOOP
  334. END SUB
  335.  
  336. SUB SecimDos (Dosya$(), Diz$())
  337.      ON LOCAL ERROR GOTO SecimHata
  338.      Yer = 8: Sat = 9
  339.   DO
  340.      SELECT CASE Sat
  341.     CASE 9
  342.       V = V1 * 13 + Yer - 8
  343.     CASE 24, 39
  344.       V = V1 * 13 + Yer - 8 + (Sat - 9) / 15 * 13
  345.     CASE 54
  346.       V1 = V1 + 1
  347.     CASE -6
  348.       IF V1 > 0 THEN V1 = V1 - 1
  349.      END SELECT
  350.      SELECT CASE Sat
  351.        CASE 54, -6
  352.     CALL EkranYaz(Dosya$(), Diz$(), V1)
  353.     IF Sat = -6 THEN Sat = 9 ELSE Sat = 39
  354.     V = V1 * 13 + Yer - 8 + ((Sat - 9) \ 15) * 13
  355.      END SELECT
  356.      Sec$ = Dosya$(V)
  357.      COLOR 14, 1: LOCATE 21, 9 + V / 7: PRINT "█": LOCATE 9, 72: PRINT "█"
  358.      COLOR 1, 15: LOCATE Yer, Sat - 1: PRINT " "; Sec$; " "
  359.      COLOR 15, 1
  360.      LOCATE 5, 9: PRINT SPACE$(12); : LOCATE , 26: PRINT SPACE$(46); : LOCATE , 9: PRINT Sec$; : LOCATE , 26: PRINT LEFT$(Sur$ + Dz$, 46)
  361.      DO: A$ = INKEY$
  362.        IF Sec$ = "" THEN A$ = CHR$(9): EXIT DO
  363.      LOOP UNTIL A$ <> ""
  364.      LOCATE Yer, Sat - 1: PRINT " "; Sec$; " ": IF Sec$ = Mes$ THEN COLOR 30, 1: LOCATE Yer, Sat: PRINT Mes$
  365.      COLOR 1, 3: LOCATE 21, 9 + V / 7: PRINT "░"
  366.      SELECT CASE ASC(A$)
  367.       CASE 9
  368.          T$ = CHR$(Ses)
  369.          CALL SecimDiz(Dosya$(), Diz$(), T$)
  370.          IF ASC(T$) = 13 THEN Tarama: Yer = 8: Sat = 9: V1 = 0
  371.          IF ASC(T$) = 27 THEN IF Ses = 0 THEN EXIT SUB ELSE Ses = 0: LOCATE 5, 8: COLOR 15, 1: PRINT SPACE$(14); : LOCATE , 25: PRINT SPACE$(48): YavasKapa: FOR I = 1 TO 5: Bekle: NEXT: Kapa
  372.       CASE 13
  373.          IF Ses = 1 THEN Kapa ELSE Ses = 1
  374.          Mes$ = Sec$
  375.          CALL EkranYaz(Dosya$(), Diz$(), V1)
  376.          CLOSE #1: OPEN Sur$ + Dz$ + Sec$ FOR BINARY AS #1
  377.          Yap.HscDt = SPACE$(LOF(1))
  378.          GET #1, , Yap.HscDt
  379.          Dinle VARSEG(Yap.HscDt), VARPTR(Yap.HscDt), BellekC%
  380.          S$ = RTRIM$(Sec$): MID$(Kayan$, 60, 15) = SPACE$(15): MID$(Kayan$, 76 - LEN(S$), LEN(S$)) = S$
  381.        CASE 27: IF Ses = 0 THEN EXIT SUB ELSE Ses = 0: LOCATE 5, 8: COLOR 15, 1: PRINT SPACE$(14); : LOCATE , 25: PRINT SPACE$(48): YavasKapa: FOR I = 1 TO 5: Bekle: NEXT: Kapa: Mes$ = "": CALL EkranYaz(Dosya$(), Diz$(), V1)
  382.        CASE 255
  383.          IF Ses = 1 THEN
  384.          PCOPY 0, 2: Ekransakla
  385.          EskiS$ = LEFT$(CURDIR$, 2): EskiD$ = RIGHT$(CURDIR$, LEN(CURDIR$) - 2)
  386.          COLOR 7, 1: CLS : PRINT "Geri dönüƒ için ≈EXIT≈ yazmanìz gerekir."
  387.          SHELL: CHDRIVE EskiS$: CHDIR EskiD$: EkranKoy: PCOPY 2, 0
  388.          END IF
  389.        CASE 253: IF Ses = 1 THEN Ses = 0: LOCATE 5, 8: COLOR 15, 1: PRINT SPACE$(14); : LOCATE , 25: PRINT SPACE$(48): Kapa: Mes$ = "": CALL EkranYaz(Dosya$(), Diz$(), V1)
  390.        CASE 254: Yardim
  391.      END SELECT
  392.      IF LEN(A$) = 2 THEN
  393.     Z = ASC(RIGHT$(A$, 1))
  394.     SELECT CASE Z
  395.          CASE 80
  396.            IF Dosya$(V + 1) <> "" AND Yer < 20 THEN Yer = Yer + 1 ELSE IF Dosya$(V + 1) <> "" THEN Yer = 8: Sat = Sat + 15
  397.          CASE 79
  398.         V = Adet1: V1 = (V \ 39) * 3: Sat = 9 + ((V - V1 * 13) \ 13) * 15: Yer = 7 + V - V1 * 13 - ((Sat - 9) \ 15) * 13
  399.         CALL EkranYaz(Dosya$(), Diz$(), V1)
  400.          CASE 81
  401.         V = V + 39: Y = 8: IF V > Adet1 THEN V = Adet1: Y = 7
  402.         V1 = (V \ 39) * 3: Sat = 9 + ((V - V1 * 13) \ 13) * 15: Yer = Y + V - V1 * 13 - ((Sat - 9) \ 15) * 13
  403.         CALL EkranYaz(Dosya$(), Diz$(), V1)
  404.          CASE 71
  405.         Yer = 8: Sat = 9: V1 = 0: CALL EkranYaz(Dosya$(), Diz$(), V1)
  406.          CASE 72
  407.            IF Yer > 8 THEN Yer = Yer - 1 ELSE IF V <> 0 THEN IF Dosya$(V - 1) <> "" THEN Yer = 20: Sat = Sat - 15
  408.          CASE 73
  409.         V = V - 39: Y = 8: IF V < 0 THEN V = 1: Y = 7
  410.         V1 = (V \ 39) * 3: Sat = 9 + ((V - V1 * 13) \ 13) * 15
  411.         Yer = Y + V - V1 * 13 - ((Sat - 9) \ 15) * 13
  412.         CALL EkranYaz(Dosya$(), Diz$(), V1)
  413.          CASE 77
  414.            IF Dosya$((V \ 13) * 13 + 13) <> "" THEN
  415.                Sat = Sat + 15
  416.                DO
  417.             IF Dosya$(V + 13) <> "" THEN EXIT DO ELSE Yer = Yer - 1: V = V - 1
  418.                LOOP
  419.            END IF
  420.          CASE 75
  421.            IF V > 0 THEN Sat = Sat - 15
  422.          CASE 32
  423.         PCOPY 0, 2
  424.         CALL CerceveCiz(12, 9, 2, 40, "")
  425.         LOCATE 13, 11: PRINT RTRIM$(Sec$); " silinsin mi? E)vet H)ayìr"
  426.         DO: A$ = INKEY$: LOOP UNTIL A$ <> ""
  427.             IF A$ = "E" OR A$ = "e" THEN
  428.                CLOSE : KILL Sec$: Tarama: Yer = 8: Sat = 9: V1 = 0
  429.             ELSE
  430.                PCOPY 2, 0
  431.             END IF
  432.          CASE 19
  433.         PCOPY 0, 2
  434.         CALL CerceveCiz(12, 9, 2, 40, ""): LOCATE 13, 10: PRINT "Yeni dosya ismini giriniz:"
  435.         S$ = LEFT$(Sec$ + SPACE$(12), 12): F = LEN(RTRIM$(Sec$)) + 1: IF F > 12 THEN F = 12
  436.               DO
  437.              COLOR 1, 7: LOCATE 13, 37: PRINT S$: LOCATE 13, 36 + F, 1
  438.              IF ins = 0 THEN LOCATE , , , 7, 8 ELSE LOCATE , , , 7, 13
  439.              DO: A$ = INKEY$: LOOP UNTIL A$ <> ""
  440.              LOCATE , , 0
  441.              IF LEN(A$) = 2 THEN Z = ASC(RIGHT$(A$, 1)) ELSE Z = ASC(A$)
  442.              SELECT CASE Z
  443.                    CASE 27: PCOPY 2, 0: EXIT DO
  444.                    CASE 13: CLOSE : Hata = 0: NAME Sur$ + Dz$ + Sec$ AS Sur$ + Dz$ + RTRIM$(S$)
  445.                    IF Hata = 0 THEN Dosya$(V) = S$
  446.                    PCOPY 2, 0: EXIT DO
  447.                    CASE 75: IF F > 1 THEN F = F - 1
  448.                    CASE 77: IF F < 12 THEN F = F + 1
  449.                    CASE 82: IF ins = 0 THEN ins = 1 ELSE ins = 0
  450.                    CASE 83: S$ = LEFT$(S$, F - 1) + RIGHT$(S$, 12 - F) + " "
  451.                    CASE 8: S$ = LEFT$(S$, F - 1) + RIGHT$(S$, 12 - F) + " ": IF F > 1 THEN F = F - 1
  452.                    CASE ELSE
  453.                   IF LEN(A$) = 1 THEN
  454.                     IF ins = 1 THEN MID$(S$, F) = A$ ELSE S$ = LEFT$(LEFT$(S$, F - 1) + A$ + RIGHT$(S$, 12 - F + 1), 12)
  455.                     IF F < 12 THEN F = F + 1
  456.                   END IF
  457.              END SELECT
  458.                LOOP
  459.     END SELECT
  460.      END IF
  461.   LOOP
  462. EXIT SUB
  463. SecimHata:
  464.   Hata = 1: RESUME NEXT
  465. END SUB
  466.  
  467. SUB Tarama
  468.      PCOPY 3, 0
  469.      CALL CerceveCiz(12, 9, 2, 40, "")
  470.      LOCATE 13, 10: PRINT "Dosyalarì tarìyorum, lütfen bekleyiniz.."
  471.      FOR I = 0 TO 301: Dosya$(I) = "": Diz$(I) = "": NEXT
  472.      D$ = CURDIR$: IF LEN(D$) = 3 THEN D$ = LEFT$(D$, 2)
  473.      Ara$ = D$ + "\*.*"
  474.      CALL Bul(Ara$, Dosya$(), Diz$())
  475.      FOR I = 0 TO 12
  476.        COLOR 15, 1
  477.        LOCATE 8 + I, 9: PRINT SPACE$(42);
  478.        LOCATE , 9: PRINT Dosya$(I); : LOCATE , 24: PRINT Dosya$(I + 13); : LOCATE , 39: PRINT Dosya$(I + 26); : LOCATE , 59: PRINT Diz$(I);
  479.        COLOR 30, 1
  480.      IF Dosya$(I) = Mes$ THEN LOCATE , 9: PRINT Mes$
  481.      IF Dosya$(I + 13) = Mes$ THEN LOCATE , 24: PRINT Mes$
  482.      IF Dosya$(I + 26) = Mes$ THEN LOCATE , 39: PRINT Mes$
  483.      NEXT
  484.      Sur$ = LEFT$(CURDIR$, 3): Dz$ = ""
  485.      IF LEN(CURDIR$) > 3 THEN Dz$ = RIGHT$(CURDIR$, LEN(CURDIR$) - 3) + "\"
  486. END SUB
  487.  
  488. SUB Yardim
  489.     PCOPY 0, 2
  490.     Sa = CSRLIN: Su = POS(0)
  491.     COLOR 15, 1: CLS
  492.     CALL CerceveCiz(1, 2, 2, 76, "")
  493.     COLOR 15, 1: LOCATE 2, 4: PRINT "HSCDINLE, Gürol DEMÿR & M.Doºan ÖZDEMÿR - (c) 1996 Shareware versiyon 1.01"
  494.     CALL CerceveCiz(5, 2, 17, 76, "Yardìm")
  495.     CALL CerceveCiz(6, 7, 2, 67, ""): LOCATE 6, 10: PRINT "Gereksinim": COLOR 15, 1:
  496.     LOCATE 7, 9: PRINT "Bu ≈Hsc≈ dinletici program, adlib uyumlu ses kartlarìnda çalìƒìr."
  497.     CALL CerceveCiz(10, 13, 6, 52, "Tuƒlarìn iƒlevleri (Melodi)"): COLOR 15, 1
  498.     LOCATE 11, 15: PRINT "Dinleme                   : Enter"
  499.     LOCATE 12, 15: PRINT "Yavas kapatma             : Esc"
  500.     LOCATE 13, 15: PRINT "Hìzlì Kapatma             : F2"
  501.     LOCATE 14, 15: PRINT "Müzik ile Dos'da gezinti  : F10"
  502.     LOCATE 15, 15: PRINT "Dinlenecek parçanìn seçimi: Cursor hareket Tuƒlarì"
  503.     CALL CerceveCiz(18, 5, 3, 31, "Tuƒlarìn iƒlevleri (Dosya)"): COLOR 15, 1
  504.     LOCATE 19, 7: PRINT "Alt+R  : Yeniden isimlendirme"
  505.     LOCATE 20, 7: PRINT "Alt+D  : Müzik dosyasìnì sil"
  506.     CALL CerceveCiz(19, 49, 2, 27, "Express Tsr"): COLOR 15, 1
  507.     LOCATE 20, 51: PRINT "HSCDINLE müzikdosyasì.adì"
  508.     DO: LOOP UNTIL INKEY$ <> ""
  509.     LOCATE Sa, Su
  510.     PCOPY 2, 0
  511. END SUB
  512.  
  513.